Practica_ReduccionDimensiones

1. Linear methods: PCA

set.seed(42)
pca_mydata <- prcomp(mydata[,-1], scale. = F)

Cols=function(vec){cols=c("green", "red")
+ return(cols[as.numeric(as.factor(vec))]) }
labels <- mydata$SD
par(mfrow=c(1,1))
plot(pca_mydata$x[,1:2], col=Cols(labels))
title(main = "PCA without scaling the datasample, 20k datapoints")

biplot(pca_mydata, xlabs=rep(".", nrow(mydata)))
title(main = "biplot of PCA without scaling the datasample, 20k datapoints")

pca_mydata$rotation %>% kable(row.names = T)

# Percent Variance Explained
pr.var = pca_mydata$sdev^2
pve = pr.var/sum(pr.var)
pve

##  [1] 0.32005368 0.20384070 0.11756412 0.08471263 0.07862810 0.05886057
##  [7] 0.04138278 0.03665455 0.03382128 0.01231714 0.01216444

par(mfrow=c(1,2))
plot(pve, xlab="Principal Component", ylab="Percent Variance Explained", ylim=c(0,1), type='b')
plot(cumsum(pve), xlab="Principal Component", ylab="Accumulated Percent Variance Explained",
     ylim=c(0,1), type='b', col='blue') + abline(h=0.75, col='red')

## integer(0)

set.seed(42)
pca_mydata <- prcomp(mydata[,-1], scale. = T)

par(mfrow=c(1,1))
plot(pca_mydata$x[,1:2], col=Cols(labels))
title(main = "PCA after scaling the datasample, 20k datapoints")

biplot(pca_mydata, xlabs=rep(".", nrow(mydata)))
title(main = "biplot of PCA after scaling the datasample")

pca_mydata$rotation %>% kable(row.names = T)

# Percent Variance Explained
pr.var = pca_mydata$sdev^2
pve = pr.var/sum(pr.var)
pve

##  [1] 0.24802228 0.20157463 0.15011676 0.10426470 0.07586700 0.05980580
##  [7] 0.04673449 0.04179853 0.03818827 0.01864291 0.01498462

par(mfrow=c(1,2))
plot(pve, xlab="Principal Component", ylab="Percent Variance Explained", ylim=c(0,1), type='b')
plot(cumsum(pve), xlab="Principal Component", ylab="Accumulated Percent Variance Explained",
     ylim=c(0,1), type='b', col='blue') + abline(h=0.75, col='red')

## integer(0)

PCA 3D

gr <- factor(mydata[,1])
colors = mapvalues(gr, from = c(0, 1), to = c("green", "red"))
summary(gr)

##     0     1 
## 10026 10026

pca3d(pca_mydata, group = gr, col = colors)

## [1] 0.2727411 0.1550222 0.1535694
## Creating new device

snapshotPCA3d(file="PCA3D_20k.png")

Smaller sample

I now take a smaller sample, which is important for using t-SNE later on.
For this sample I take 500 datapoints with SD=0 and 500 datapoints with SD=1.

set.seed(42)
SD0_sample_500 <- sample_n(SD0, 500)
SD1_sample_500 <- sample_n(SD1, 500)
mydata_balanced_1k <- rbind(SD0_sample_500, SD1_sample_500)
mydata <- mydata_balanced_1k[sample(1000),]
summary(mydata)

##        SD           Age               RUUL           DebtRatio      
##  Min.   :0.0   Min.   :-2.0510   Min.   :-0.9038   Min.   :-1.3165  
##  1st Qu.:0.0   1st Qu.:-0.9001   1st Qu.:-0.7070   1st Qu.:-0.5593  
##  Median :0.5   Median :-0.2231   Median : 0.3354   Median : 0.0000  
##  Mean   :0.5   Mean   :-0.1811   Mean   : 0.4848   Mean   : 0.1580  
##  3rd Qu.:1.0   3rd Qu.: 0.3862   3rd Qu.: 1.6450   3rd Qu.: 0.5456  
##  Max.   :1.0   Max.   : 2.8911   Max.   : 2.8884   Max.   : 6.0776  
##    OpenCredit          REloans              Dep              no3059       
##  Min.   :-1.64260   Min.   :-0.91196   Min.   :-0.6667   Min.   :-0.3519  
##  1st Qu.:-0.67097   1st Qu.:-0.91196   1st Qu.:-0.6667   1st Qu.:-0.3519  
##  Median :-0.08798   Median :-0.01585   Median :-0.6667   Median :-0.3519  
##  Mean   : 0.01015   Mean   : 0.01193   Mean   : 0.1453   Mean   : 0.5474  
##  3rd Qu.: 0.49500   3rd Qu.: 0.88026   3rd Qu.: 1.1417   3rd Qu.: 1.0823  
##  Max.   : 7.87944   Max.   : 9.84139   Max.   : 6.5668   Max.   :11.1221  
##     LateDays         logIncome              Debt        
##  Min.   :-0.3103   Min.   :-10.54352   Min.   :-1.2109  
##  1st Qu.:-0.3103   1st Qu.: -0.40410   1st Qu.:-0.7249  
##  Median :-0.3103   Median :  0.21230   Median : 0.0596  
##  Mean   : 0.7860   Mean   : -0.02264   Mean   : 0.1020  
##  3rd Qu.: 1.1315   3rd Qu.:  0.40187   3rd Qu.: 0.4679  
##  Max.   :15.0694   Max.   :  1.35199   Max.   : 7.5926  
##      Slack         
##  Min.   :-2.68051  
##  1st Qu.:-0.75851  
##  Median :-0.08469  
##  Mean   :-0.10551  
##  3rd Qu.: 0.25036  
##  Max.   : 3.93283

set.seed(42)
pca_mydata <- prcomp(mydata[,-1], scale. = T)

gr <- factor(mydata[,1])
colors = mapvalues(gr, from = c(0, 1), to = c("green", "red"))
summary(gr)

##   0   1 
## 500 500

pca3d(pca_mydata, group = gr, show.ellipses=TRUE, ellipse.ci=0.75, show.plane=F, col = colors)

## [1] 0.1760447 0.1136925 0.1375280

snapshotPCA3d(file="PCA3D_1k.png")

2. Non-Linear methods: t-SNE

The TSNE algorithm can be used to map high dimensional data sets onto a 2 or 3 dimensional graph.
I’ll use the reduced dataset, because when the number of observations is too large (more than 10.000), the algortihm takes a lot of time and the visualizaton doesn’t work.
A feature of t-SNE is a tuneable parameter “perplexity”, which says (loosely) how to balance attention between local and global aspects of your data. The parameter is, in a sense, a guess about the number of close neighbors each point has. I will vary the perplexity parameter, to see what effect it has on my data.

mydata_matrix <- as.matrix(unique(mydata[,-1]))
set.seed(42)
tsne_out <- Rtsne(mydata_matrix, dims = 2, perplexity=30, verbose=TRUE, max_iter = 500) # Run TSNE

## Read the 1000 x 11 data matrix successfully!
## Using no_dims = 2, perplexity = 30.000000, and theta = 0.500000
## Computing input similarities...
## Normalizing input...
## Building tree...
##  - point 0 of 1000
## Done in 0.10 seconds (sparsity = 0.128138)!
## Learning embedding...
## Iteration 50: error is 69.757288 (50 iterations in 0.46 seconds)
## Iteration 100: error is 67.910138 (50 iterations in 0.45 seconds)
## Iteration 150: error is 67.901686 (50 iterations in 0.41 seconds)
## Iteration 200: error is 67.901316 (50 iterations in 0.42 seconds)
## Iteration 250: error is 67.901649 (50 iterations in 0.42 seconds)
## Iteration 300: error is 1.462661 (50 iterations in 0.41 seconds)
## Iteration 350: error is 1.288151 (50 iterations in 0.42 seconds)
## Iteration 400: error is 1.242164 (50 iterations in 0.42 seconds)
## Iteration 450: error is 1.220981 (50 iterations in 0.42 seconds)
## Iteration 500: error is 1.211245 (50 iterations in 0.42 seconds)
## Fitting performed in 4.25 seconds.

save(tsne_out, file="/Users/Jurjen/OneDrive - U-tad/ReduccionDimensiones/Practica/tsne_out_per30.RData")
plot(tsne_out$Y, col=Cols(mydata$SD))
title(main = "t-SNE, perplexity=30")

mydata_matrix <- as.matrix(unique(mydata[,-1]))
set.seed(42)
tsne_out <- Rtsne(mydata_matrix, dims = 2, perplexity=50, verbose=TRUE, max_iter = 500) # Run TSNE

## Read the 1000 x 11 data matrix successfully!
## Using no_dims = 2, perplexity = 50.000000, and theta = 0.500000
## Computing input similarities...
## Normalizing input...
## Building tree...
##  - point 0 of 1000
## Done in 0.17 seconds (sparsity = 0.213184)!
## Learning embedding...
## Iteration 50: error is 63.671460 (50 iterations in 0.51 seconds)
## Iteration 100: error is 63.154005 (50 iterations in 0.53 seconds)
## Iteration 150: error is 62.757511 (50 iterations in 0.46 seconds)
## Iteration 200: error is 62.757626 (50 iterations in 0.46 seconds)
## Iteration 250: error is 62.757590 (50 iterations in 0.46 seconds)
## Iteration 300: error is 1.274432 (50 iterations in 0.45 seconds)
## Iteration 350: error is 1.146637 (50 iterations in 0.45 seconds)
## Iteration 400: error is 1.109491 (50 iterations in 0.45 seconds)
## Iteration 450: error is 1.097372 (50 iterations in 0.45 seconds)
## Iteration 500: error is 1.092265 (50 iterations in 0.44 seconds)
## Fitting performed in 4.66 seconds.

save(tsne_out, file="/Users/Jurjen/OneDrive - U-tad/ReduccionDimensiones/Practica/tsne_out_per50.RData")
plot(tsne_out$Y, col=Cols(mydata$SD))
title(main = "t-SNE, perplexity=50")

mydata_matrix <- as.matrix(unique(mydata[,-1]))
set.seed(42)
tsne_out <- Rtsne(mydata_matrix, dims = 2, perplexity=100, verbose=TRUE, max_iter = 500) # Run TSNE

## Read the 1000 x 11 data matrix successfully!
## Using no_dims = 2, perplexity = 100.000000, and theta = 0.500000
## Computing input similarities...
## Normalizing input...
## Building tree...
##  - point 0 of 1000
## Done in 0.36 seconds (sparsity = 0.418520)!
## Learning embedding...
## Iteration 50: error is 55.392553 (50 iterations in 0.61 seconds)
## Iteration 100: error is 55.392553 (50 iterations in 0.58 seconds)
## Iteration 150: error is 55.392553 (50 iterations in 0.57 seconds)
## Iteration 200: error is 55.392553 (50 iterations in 0.60 seconds)
## Iteration 250: error is 55.392553 (50 iterations in 0.62 seconds)
## Iteration 300: error is 0.978117 (50 iterations in 0.62 seconds)
## Iteration 350: error is 0.859854 (50 iterations in 0.55 seconds)
## Iteration 400: error is 0.842660 (50 iterations in 0.53 seconds)
## Iteration 450: error is 0.836733 (50 iterations in 0.54 seconds)
## Iteration 500: error is 0.833816 (50 iterations in 0.54 seconds)
## Fitting performed in 5.77 seconds.

save(tsne_out, file="/Users/Jurjen/OneDrive - U-tad/ReduccionDimensiones/Practica/tsne_out_per100.RData")
plot(tsne_out$Y, col=Cols(mydata$SD))
title(main = "t-SNE, perplexity=100")

When I set perplexity=100 it gives the best separation of the red and green points.

mydata_matrix <- as.matrix(unique(mydata[,-1]))
set.seed(42)
tsne_out <- Rtsne(mydata_matrix, dims = 3, perplexity=100, verbose=TRUE, max_iter = 500) # Run TSNE

## Read the 1000 x 11 data matrix successfully!
## Using no_dims = 3, perplexity = 100.000000, and theta = 0.500000
## Computing input similarities...
## Normalizing input...
## Building tree...
##  - point 0 of 1000
## Done in 0.36 seconds (sparsity = 0.418520)!
## Learning embedding...
## Iteration 50: error is 55.392553 (50 iterations in 0.94 seconds)
## Iteration 100: error is 55.392553 (50 iterations in 0.85 seconds)
## Iteration 150: error is 55.392553 (50 iterations in 0.87 seconds)
## Iteration 200: error is 55.392553 (50 iterations in 0.91 seconds)
## Iteration 250: error is 55.392553 (50 iterations in 0.96 seconds)
## Iteration 300: error is 0.816494 (50 iterations in 0.94 seconds)
## Iteration 350: error is 0.703511 (50 iterations in 0.87 seconds)
## Iteration 400: error is 0.683349 (50 iterations in 0.91 seconds)
## Iteration 450: error is 0.672979 (50 iterations in 0.88 seconds)
## Iteration 500: error is 0.668926 (50 iterations in 0.88 seconds)
## Fitting performed in 9.01 seconds.

save(tsne_out, file="/Users/Jurjen/OneDrive - U-tad/ReduccionDimensiones/Practica/tsne_out_per100.RData")
plot(tsne_out$Y, col=Cols(mydata$SD))
title(main = "t-SNE, perplexity=100, dims=3")

scatterplot3d(x=tsne_out$Y[,1],y=tsne_out$Y[,2],z=tsne_out$Y[,3], color = Cols(mydata$SD))
title(main = "t-SNE, perplexity=100, dims=3")

plot3d(x=tsne_out$Y[,1],y=tsne_out$Y[,2],z=tsne_out$Y[,3],
       col = Cols(mydata$SD),
       type="s",radius=0.5)

Conclusions

This visualization with t-SNE shows that it should be reasonably possible to separate the data in a higher dimension (in my case 11 dimensions). Although a fraction of the points will be misclassified.

From this analysis I would say that it seems like a good idea to keep the 11 variables that I obtained after data preparacion and try to use a nonlinear algorithm (like a neural network) to predict the probability that somebody will experience financial distress in the next two years. I have a lot of data to train the network on. Although it would be interesting to compare with the results of linear classification, either with PCA or keeping only the most ‘important’ variables. Because PCA suggests (looking at the 3D graph of 20.000 datapoints) that up to a certain accuracy the data are linearly separable.

Extra: KernelPCA

The idea of kernelPCA is to first transform the data to another space using a kernel and do PCA in that space.
I will use a Radial Basis Kernel, and look at different values of sigma.

kpc <- kpca(~., data = mydata[,-1], kernel = "rbfdot", kpar = list(sigma = 0.0001), features = 2)
plot(rotated(kpc), col=Cols(mydata$SD))
title(main = "KernelPCA (without scaling the datasample), Radial Basis kernel, sigma=0.0001")

kpc <- kpca(~., data = mydata[,-1], kernel = "rbfdot", kpar = list(sigma = 0.01), features = 2)
plot(rotated(kpc), col=Cols(mydata$SD))
title(main = "KernelPCA (without scaling the datasample), Radial Basis kernel, sigma=0.01")

kpc <- kpca(~., data = mydata[,-1], kernel = "rbfdot", kpar = list(sigma = 0.0001), features = 3)
plot3d(x=rotated(kpc)[,1],y=rotated(kpc)[,2],z=rotated(kpc)[,3],
       col = Cols(mydata$SD),
       type="s",radius=0.1)

I thought that scaling has to occur after applying the kernel, but I’m not sure if kpca does this automatically. Let’s see what happens when we scale the data first.

trans = preProcess(mydata[,-1], 
                   method=c("center", "scale"))
mydata_norm = predict(trans, mydata)

kpc <- kpca(~., data = mydata_norm[,-1], kernel = "rbfdot", kpar = list(sigma = 0.0001), features = 2)
plot(rotated(kpc), col=Cols(mydata$SD))
title(main = "KernelPCA (after scaling datasample), Radial Basis kernel, sigma=0.0001")

kpc <- kpca(~., data = mydata_norm[,-1], kernel = "rbfdot", kpar = list(sigma = 0.0001), features = 3)
plot3d(x=rotated(kpc)[,1],y=rotated(kpc)[,2],z=rotated(kpc)[,3],
       col = Cols(mydata$SD),
       type="s",radius=0.1)

I’m not sure if scaling before kpca makes things better…